Cream of the Crop 1/Cream of the Crop 1.iso/PROGRAM/GAUGE.ARJ/UTILS.PAS

Pascal/Delphi Source File | 1992-02-13 | 6KB | 265 lines

{$N+}
unit Utils;
interface

uses
  WinTypes, WinProcs, Strings, WinDOS;


type
  DriveStr = array[0..2] of Char;
  DriveRec = Record
    dLetter : DriveStr;
    dTotal  : LongInt;
  end;

var
  avDrives   : array[0..23] of DriveRec;
  dChoice    : Integer;


function GetHeapSpaces(hModule : THandle) : LongInt;
procedure heapInfo(module : PChar; var pfree, ptotal, ppercent : Word);
function GetFreeResources : LongInt;
procedure SetInternational;
procedure GetCurTime(var tTime : PChar);
procedure GetCurDate(var cDate : PChar);
function OneDriveInfo(drive : Integer; var total : LongInt) : Boolean;
function GetDriveInfo : Integer;
function GetFreeMemory : String;
procedure GetAvail(theDrive : Integer; total : LongInt;
                   var avail : LongInt; var ratio : Single);


implementation

var
  iDate,
  iTime : Integer;
  sDate : array[0..1] of Char;
  sTime : array[0..1] of Char;
  sAMPM : array[0..1, 0..4] of Char;

(* -------------  Undocumented Windows function ---------------- *)

function GetHeapSpaces(hModule : THandle) : LongInt;
  external 'KERNEL' index 138;

(* ------------------------------------------------------------- *)
procedure heapInfo(module : PChar; var pfree, ptotal, ppercent : Word);
  var
    info : LongInt;
  begin
    info := GetHeapSpaces(GetModuleHandle(module));
    pfree := LoWord(info);
    ptotal := Hiword(info);
    info := Word((LongInt(pfree) * 100) div ptotal);
    ppercent := info;
  end;

function GetFreeResources : LongInt;
  var
    userFree,
    userTotal,
    userPercent,
    gdiFree,
    gdiTotal,
    gdiPercent : Word;
  begin
    heapInfo('USER', userFree, userTotal, userPercent);
    heapInfo('GDI', gdiFree, gdiTotal, gdiPercent);
    GetFreeResources := MakeLong(userPercent, gdiPercent);
  end;


procedure SetInternational;
  const
    cName = 'intl';
  begin
    iDate := GetProfileInt(cName, 'iDate', 0);
    iTime := GetProfileInt(cName, 'iTime', 0);

    GetProfileString(cName, 'sDate', '/', sDate,     2);
    GetProfileString(cName, 'sTime', ':', sTime,     2);
    GetProfileString(cName, 's1159', 'AM', sAMPM[0], 5);
    GetProfileString(cName, 's2359', 'PM', sAMPM[1], 5);
  end;


procedure GetCurTime(var tTime : PChar);
  type
    shTime = Record
      shHr  : Word;
      shSep : array[0..1] of Char;
      shMin : Word;
    end;
    lTime = Record
      shHr  : Word;
      shSep : array[0..1] of Char;
      shMin : Word;
      ampm  : PChar;
      {ampm  : array[0..4] of Char;}
    end;
  var
    hr,
    tmin,
    sec,
    hsec  : Word;
    shortTime : shTime;
    longTime  : lTime;
  begin
    GetTime(hr, tmin, sec, hsec);
    with shortTime do begin
      shHr := hr;
      shMin := tmin;
      StrCopy(shSep, sTime);
    end;
    with longTime do begin
      shHr := hr;
      shMin := tmin;
      StrCopy(shSep, sTime);
      GetMem(ampm, 5);
      StrCopy(ampm, sAMPM[hr div 12]);
    end;
    if iTime = 1 then
      begin
        GetMem(tTime, 6);
        wvsprintf(tTime, '%02d%c%02d', shortTime);
      end
    else begin
      GetMem(tTime, 9);
      if (hr mod 12) <> 0 then
        longTime.shHr := hr mod 12
      else
        longTime.shHr := 12;

      wvsprintf(tTime, '%02d%c%02d %s', longTime);
    end;
    FreeMem(longTime.ampm, 5);
  end;

procedure GetCurDate(var cDate : PChar);
  type
    DateRec = Record
      tday  : Word;
      sep1  : array[0..1] of Char;
      month : Word;
      sep2  : array[0..1] of Char;
      year  : Word;
    end;
  var
    yr,
    mo,
    day,
    dweek   : Word;
    lDate : DateRec;
  begin
    GetMem(cDate, 9);
    {GetMem(lDate.sep1, 2);}
    {GetMem(lDate.sep2, 2);}
    GetDate(yr, mo, day, dweek);
    yr := yr mod 100;
    case iDate of
      1 :
        begin
          with lDate do begin
            tday := day;
            month := mo;
            year := yr;
            StrCopy(sep1, sDate);
            StrCopy(sep2, sDate);
          end;
        end;

      2 :
        begin
          with lDate do begin
            tday := yr;
            month := mo;
            year := day;
            StrCopy(sep1, sDate);
            StrCopy(sep2, sDate);
          end;
        end;

    else begin
        with lDate do begin
          tday := mo;
          month := day;
          year := yr;
          StrCopy(sep1, sDate);
          StrCopy(sep2, sDate);
        end;
    end;
    end;
    wvsprintf(cDate, '%02d%c%02d%c%02d', lDate);
  end;


function OneDriveInfo(drive : Integer; var total : LongInt) : Boolean;
  var
    dType : Word;
  begin
    OneDriveInfo := False;
    total := 0;

    dType := GetDriveType(drive - 1);
    if (dType >= drive_Removable) then begin
      OneDriveInfo := True;
      total := DiskSize(drive) div 1024 div 1024;
    end;
  end;

function GetDriveInfo : Integer;
  var
    i, j  : Integer;
    Total : LongInt;
    isOK  : Boolean;
  begin
    i := 3;
    j := -1;
    isOK := True;
    while isOK do begin
      isOK := OneDriveInfo(i, Total);
      if isOK then begin
        if (Total <> 0) then begin
          Inc(j);
          with avDrives[j] do begin
            dTotal := Total;

            dLetter[0] := Chr(i + 64);
            dLetter[1] := ':';
          end;
          Inc(i);
        end
        else
          isOK := False;
      end;
    end;
    GetDriveInfo := j;
  end;

function GetFreeMemory : String;
  var
    dwFreeMem : LongInt;
    curMem,
    rMem      : Real;
    temp      : String;
  begin
    dwFreeMem := GetFreeSpace(0);
    curMem := dwFreeMem;
    rMem := curMem / 1024.0 / 1024.0;
    Str(rMem:5:2, temp);
    GetFreeMemory := Concat(temp, ' Mb');
  end;


procedure GetAvail(theDrive : Integer; total : LongInt;
                   var avail : LongInt; var ratio : Single);
  begin
    avail := DiskFree(theDrive + 3) div 1024 div 1024;
    ratio := Single(avail) / Single(total);
  end;

end.